home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / BOOT.C < prev    next >
C/C++ Source or Header  |  1992-02-10  |  18KB  |  600 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/boot.c,v 9.72 1992/02/10 13:52:23 jinx Exp $
  4.  
  5. Copyright (c) 1988-1992 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* This file contains `main' and associated startup code. */
  36.  
  37. #include "scheme.h"
  38. #include "prims.h"
  39. #include "version.h"
  40. #include "option.h"
  41. #ifndef islower
  42. #include <ctype.h>
  43. #endif
  44. #include "ostop.h"
  45.  
  46. extern PTR EXFUN (malloc, (unsigned int size));
  47. extern void EXFUN (free, (PTR ptr));
  48. extern void EXFUN (init_exit_scheme, (void));
  49. extern void EXFUN (Clear_Memory, (int, int, int));
  50. extern void EXFUN (Setup_Memory, (int, int, int));
  51. extern void EXFUN (compiler_initialize, (long fasl_p));
  52.  
  53. static void EXFUN (Start_Scheme, (int, CONST char *));
  54. static void EXFUN (Enter_Interpreter, (void));
  55.  
  56. CONST char * scheme_program_name;
  57. CONST char * OS_Name;
  58. CONST char * OS_Variant;
  59. struct obstack scratch_obstack;
  60. PTR initial_C_stack_pointer;
  61. static char * reload_saved_string;
  62. static unsigned int reload_saved_string_length;
  63.  
  64. /* If true, this is an executable created by dump-world. */
  65. Boolean scheme_dumped_p = false;
  66.  
  67. PTR
  68. DEFUN (obstack_chunk_alloc, (size), unsigned int size)
  69. {
  70.   PTR result = (malloc (size));
  71.   if (result == 0)
  72.     {
  73.       fprintf (stderr, "\n%s: unable to allocate obstack chunk of %d bytes\n",
  74.            scheme_program_name, size);
  75.       fflush (stderr);
  76.       Microcode_Termination (TERM_EXIT);
  77.     }
  78.   return (result);
  79. }
  80.  
  81. #define obstack_chunk_free free
  82.  
  83. #ifndef INIT_FIXED_OBJECTS
  84. #define INIT_FIXED_OBJECTS() Fixed_Objects = (make_fixed_objects_vector ())
  85. #endif
  86.  
  87. /* Declare the outermost critical section. */
  88. DECLARE_CRITICAL_SECTION ();
  89.  
  90. #define BLOCKS_TO_BYTES(n) ((n) * 1024)
  91.  
  92. static void
  93. DEFUN (usage, (error_string), CONST char * error_string)
  94. {
  95.   fprintf (stderr, "%s: %s\n\n", scheme_program_name, error_string);
  96.   fflush (stderr);
  97.   termination_init_error ();
  98. }
  99.  
  100. /* Exit is done in a different way on some operating systems (eg. VMS)  */
  101.  
  102. #ifndef main_type
  103. #define main_type void
  104. #endif
  105.  
  106. main_type
  107. DEFUN (main, (argc, argv),
  108.        int argc AND CONST char ** argv)
  109. {
  110.   init_exit_scheme ();
  111.   scheme_program_name = (argv[0]);
  112.   initial_C_stack_pointer = (&argc);
  113.   obstack_init (&scratch_obstack);
  114.   reload_saved_string = 0;
  115.   reload_saved_string_length = 0;
  116.   read_command_line_options (argc, argv);
  117.   if (scheme_dumped_p)
  118.     {
  119.       extern SCHEME_OBJECT compiler_utilities;
  120.       extern void EXFUN (compiler_reset, (SCHEME_OBJECT));
  121.  
  122.       if (! ((Heap_Size == option_heap_size)
  123.          && (Stack_Size == option_stack_size)
  124.          && (Constant_Size == option_constant_size)))
  125.     {
  126.       fprintf (stderr, "%s: warning: ignoring allocation parameters.\n",
  127.            scheme_program_name);
  128.       fflush (stderr);
  129.     }
  130.       OS_reset ();
  131.       compiler_reset (compiler_utilities);
  132.       if (!option_band_specified)
  133.     {
  134.       printf ("Scheme Microcode Version %d.%d\n", VERSION, SUBVERSION);
  135.       OS_initialize ();
  136.       Enter_Interpreter ();
  137.     }
  138.       else
  139.     {
  140.       Clear_Memory ((BLOCKS_TO_BYTES (Heap_Size)),
  141.             (BLOCKS_TO_BYTES (Stack_Size)),
  142.             (BLOCKS_TO_BYTES (Constant_Size)));
  143.       /* We are reloading from scratch anyway. */
  144.       scheme_dumped_p = false;
  145.       if (option_fasl_file)
  146.         Start_Scheme (BOOT_FASLOAD, option_fasl_file);
  147.       else
  148.         Start_Scheme (BOOT_LOAD_BAND, option_band_file);
  149.     }
  150.     }
  151.   else
  152.     {
  153.       Heap_Size = option_heap_size;
  154.       Stack_Size = option_stack_size;
  155.       Constant_Size = option_constant_size;
  156.       Setup_Memory ((BLOCKS_TO_BYTES (Heap_Size)),
  157.             (BLOCKS_TO_BYTES (Stack_Size)),
  158.             (BLOCKS_TO_BYTES (Constant_Size)));
  159.       if (option_fasl_file)
  160.     {
  161.       compiler_initialize (1);
  162.       Start_Scheme (BOOT_FASLOAD, option_fasl_file);
  163.     }
  164.       else
  165.     {
  166.       compiler_initialize (0);
  167.       Start_Scheme (BOOT_LOAD_BAND, option_band_file);
  168.     }
  169.     }
  170.   termination_init_error ();
  171. }
  172.  
  173. SCHEME_OBJECT
  174. DEFUN_VOID (make_fixed_objects_vector)
  175. {
  176.   extern SCHEME_OBJECT initialize_history ();
  177.   extern SCHEME_OBJECT make_primitive ();
  178.   /* Create the fixed objects vector,
  179.      with 4 extra slots for expansion and debugging. */
  180.   fast SCHEME_OBJECT fixed_objects_vector =
  181.     (make_vector ((NFixed_Objects + 4), SHARP_F, false));
  182.   FAST_VECTOR_SET (fixed_objects_vector, Me_Myself, fixed_objects_vector);
  183.   FAST_VECTOR_SET
  184.     (fixed_objects_vector, Non_Object, (MAKE_OBJECT (TC_TRUE, 2)));
  185.   FAST_VECTOR_SET
  186.     (fixed_objects_vector,
  187.      System_Interrupt_Vector,
  188.      (make_vector ((MAX_INTERRUPT_NUMBER + 2), SHARP_F, false)));
  189.   /* Error vector is not needed at boot time */
  190.   FAST_VECTOR_SET (fixed_objects_vector, System_Error_Vector, SHARP_F);
  191.   FAST_VECTOR_SET
  192.     (fixed_objects_vector,
  193.      OBArray,
  194.      (make_vector (OBARRAY_SIZE, EMPTY_LIST, false)));
  195.   FAST_VECTOR_SET
  196.     (fixed_objects_vector, Dummy_History, (initialize_history ()));
  197.   FAST_VECTOR_SET (fixed_objects_vector, State_Space_Tag, SHARP_T);
  198.   FAST_VECTOR_SET (fixed_objects_vector, Bignum_One, (long_to_bignum (1)));
  199.  
  200.   (*Free++) = EMPTY_LIST;
  201.   (*Free++) = EMPTY_LIST;
  202.   FAST_VECTOR_SET
  203.     (fixed_objects_vector,
  204.      The_Work_Queue,
  205.      (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2))));
  206.  
  207.   FAST_VECTOR_SET
  208.     (fixed_objects_vector,
  209.      Utilities_Vector,
  210.      (make_vector (0, SHARP_F, false)));
  211.  
  212.   FAST_VECTOR_SET
  213.     (fixed_objects_vector,
  214.      GENERIC_TRAMPOLINE_ZERO_P,
  215.      (make_primitive ("INTEGER-ZERO?")));
  216.   FAST_VECTOR_SET
  217.     (fixed_objects_vector,
  218.      GENERIC_TRAMPOLINE_POSITIVE_P,
  219.      (make_primitive ("INTEGER-POSITIVE?")));
  220.   FAST_VECTOR_SET
  221.     (fixed_objects_vector,
  222.      GENERIC_TRAMPOLINE_NEGATIVE_P,
  223.      (make_primitive ("INTEGER-NEGATIVE?")));
  224.   FAST_VECTOR_SET
  225.     (fixed_objects_vector,
  226.      GENERIC_TRAMPOLINE_SUCCESSOR,
  227.      (make_primitive ("INTEGER-ADD-1")));
  228.   FAST_VECTOR_SET
  229.     (fixed_objects_vector,
  230.      GENERIC_TRAMPOLINE_PREDECESSOR,
  231.      (make_primitive ("INTEGER-SUBTRACT-1")));
  232.   FAST_VECTOR_SET
  233.     (fixed_objects_vector,
  234.      GENERIC_TRAMPOLINE_EQUAL_P,
  235.      (make_primitive ("INTEGER-EQUAL?")));
  236.   FAST_VECTOR_SET
  237.     (fixed_objects_vector,
  238.      GENERIC_TRAMPOLINE_LESS_P,
  239.      (make_primitive ("INTEGER-LESS?")));
  240.   FAST_VECTOR_SET
  241.     (fixed_objects_vector,
  242.      GENERIC_TRAMPOLINE_GREATER_P,
  243.      (make_primitive ("INTEGER-GREATER?")));
  244.   FAST_VECTOR_SET
  245.     (fixed_objects_vector,
  246.      GENERIC_TRAMPOLINE_ADD,
  247.      (make_primitive ("INTEGER-ADD")));
  248.   FAST_VECTOR_SET
  249.     (fixed_objects_vector,
  250.      GENERIC_TRAMPOLINE_SUBTRACT,
  251.      (make_primitive ("INTEGER-SUBTRACT")));
  252.   FAST_VECTOR_SET
  253.     (fixed_objects_vector,
  254.      GENERIC_TRAMPOLINE_MULTIPLY,
  255.      (make_primitive ("INTEGER-MULTIPLY")));
  256.   FAST_VECTOR_SET
  257.     (fixed_objects_vector,
  258.      GENERIC_TRAMPOLINE_DIVIDE,
  259.      SHARP_F);
  260.   FAST_VECTOR_SET
  261.     (fixed_objects_vector,
  262.      GENERIC_TRAMPOLINE_QUOTIENT,
  263.      SHARP_F);
  264.   FAST_VECTOR_SET
  265.     (fixed_objects_vector,
  266.      GENERIC_TRAMPOLINE_REMAINDER,
  267.      SHARP_F);
  268.   FAST_VECTOR_SET
  269.     (fixed_objects_vector,
  270.      GENERIC_TRAMPOLINE_MODULO,
  271.      SHARP_F);
  272.  
  273.   /* This guarantees that it will not be EQ? to anything
  274.      until smashed by the runtime system.
  275.    */
  276.  
  277.   (*Free++) = EMPTY_LIST;
  278.   (*Free++) = EMPTY_LIST;
  279.   FAST_VECTOR_SET
  280.     (fixed_objects_vector,
  281.      ARITY_DISPATCHER_TAG,
  282.      (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2))));
  283.  
  284.   return (fixed_objects_vector);
  285. }
  286.  
  287. /* Boot Scheme */
  288.  
  289. static void
  290. DEFUN (Start_Scheme, (Start_Prim, File_Name),
  291.        int Start_Prim AND CONST char * File_Name)
  292. {
  293.   extern SCHEME_OBJECT make_primitive ();
  294.   SCHEME_OBJECT FName, Init_Prog, *Fasload_Call, prim;
  295.   fast long i;
  296.   /* Parallel processor test */
  297.   Boolean I_Am_Master = (Start_Prim != BOOT_GET_WORK);
  298.   if (I_Am_Master)
  299.     {
  300.       fprintf (stdout, "Scheme Microcode Version %d.%d\n",
  301.            VERSION, SUBVERSION);
  302.       fflush (stdout);
  303.     }
  304.   OS_initialize ();
  305.   if (I_Am_Master)
  306.   {
  307.     Current_State_Point = SHARP_F;
  308.     Fluid_Bindings = EMPTY_LIST;
  309.     INIT_FIXED_OBJECTS ();
  310.   }
  311.  
  312.   /* The initial program to execute is one of
  313.         (SCODE-EVAL (BINARY-FASLOAD <file-name>) SYSTEM-GLOBAL-ENVIRONMENT),
  314.     (LOAD-BAND <file-name>), or
  315.     ((GET-WORK))
  316.      depending on the value of Start_Prim. */
  317.   switch (Start_Prim)
  318.   {
  319.     case BOOT_FASLOAD:    /* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
  320.       FName = (char_pointer_to_string ((unsigned char *) File_Name));
  321.       prim = (make_primitive ("BINARY-FASLOAD"));
  322.       Fasload_Call = Free;
  323.       *Free++ = prim;
  324.       *Free++ = FName;
  325.       prim = make_primitive("SCODE-EVAL");
  326.       Init_Prog = MAKE_POINTER_OBJECT (TC_PCOMB2, Free);
  327.       *Free++ = prim;
  328.       *Free++ = MAKE_POINTER_OBJECT (TC_PCOMB1, Fasload_Call);
  329.       *Free++ = MAKE_OBJECT (GLOBAL_ENV, GO_TO_GLOBAL);
  330.       break;
  331.  
  332.     case BOOT_LOAD_BAND:    /* (LOAD-BAND <file>) */
  333.       FName = (char_pointer_to_string ((unsigned char *) File_Name));
  334.       prim = (make_primitive ("LOAD-BAND"));
  335.       Fasload_Call = Free;
  336.       *Free++ = prim;
  337.       *Free++ = FName;
  338.       Init_Prog = MAKE_POINTER_OBJECT (TC_PCOMB1, Fasload_Call);
  339.       break;
  340.  
  341.     case BOOT_GET_WORK:        /* ((GET-WORK)) */
  342.       prim = make_primitive("GET-WORK");
  343.       Fasload_Call = Free;
  344.       *Free++ = prim;
  345.       *Free++ = SHARP_F;
  346.       Init_Prog = MAKE_POINTER_OBJECT (TC_COMBINATION, Free);
  347.       *Free++ = MAKE_OBJECT (TC_MANIFEST_VECTOR, 1);
  348.       *Free++ = MAKE_POINTER_OBJECT (TC_PCOMB1, Fasload_Call);
  349.       break;
  350.  
  351.     default:
  352.       fprintf (stderr, "Unknown boot time option: %d\n", Start_Prim);
  353.       Microcode_Termination (TERM_BAD_PRIMITIVE);
  354.       /*NOTREACHED*/
  355.   }
  356.  
  357.   /* Setup registers */
  358.   INITIALIZE_INTERRUPTS();
  359.   Env = MAKE_OBJECT (GLOBAL_ENV, 0);
  360.   Trapping = false;
  361.   Return_Hook_Address = NULL;
  362.  
  363.   /* Give the interpreter something to chew on, and ... */
  364.  Will_Push (CONTINUATION_SIZE);
  365.   Store_Return (RC_END_OF_COMPUTATION);
  366.   Store_Expression (SHARP_F);
  367.   Save_Cont ();
  368.  Pushed ();
  369.  
  370.   Store_Expression (Init_Prog);
  371.  
  372.   /* Go to it! */
  373.   if ((Stack_Pointer <= Stack_Guard) || (Free > MemTop))
  374.   {
  375.     fprintf (stderr, "Configuration won't hold initial data.\n");
  376.     termination_init_error ();
  377.   }
  378. #ifdef ENTRY_HOOK
  379.   ENTRY_HOOK ();
  380. #endif
  381.   Enter_Interpreter ();
  382. }
  383.  
  384. static void
  385. DEFUN_VOID (Enter_Interpreter)
  386. {
  387.   Interpret (scheme_dumped_p);
  388.   fprintf (stderr, "\nThe interpreter returned to top level!\n");
  389.   Microcode_Termination (TERM_EXIT);
  390. }
  391.  
  392. /* Garbage collection debugging utilities. */
  393.  
  394. extern SCHEME_OBJECT
  395.   *deadly_free,
  396.   *deadly_scan;
  397.  
  398. extern unsigned long
  399.   gc_counter;
  400.  
  401. extern void EXFUN (gc_death,
  402.            (long code, char *, SCHEME_OBJECT *, SCHEME_OBJECT *));
  403. extern void EXFUN (stack_death, (CONST char *));
  404.  
  405. extern char
  406.   gc_death_message_buffer[];
  407.  
  408. SCHEME_OBJECT
  409.   *deadly_free,
  410.   *deadly_scan;
  411.  
  412. unsigned long
  413.   gc_counter = 0;
  414.  
  415. char
  416.   gc_death_message_buffer[100];
  417.  
  418. void
  419. DEFUN (gc_death, (code, message, scan, free),
  420.        long code AND char * message
  421.        AND SCHEME_OBJECT * scan AND SCHEME_OBJECT * free)
  422. {
  423.   fprintf (stderr, "\n%s.\n", message);
  424.   fprintf (stderr, "scan = 0x%lx; free = 0x%lx\n", scan, free);
  425.   deadly_scan = scan;
  426.   deadly_free = free;
  427.   Microcode_Termination (code);
  428.   /*NOTREACHED*/
  429. }
  430.  
  431. void
  432. DEFUN (stack_death, (name), CONST char * name)
  433. {
  434.   fprintf (stderr,
  435.        "\n%s: Constant space is no longer sealed!\n",
  436.        name);
  437.   fprintf (stderr,
  438.        "Perhaps a runaway recursion has overflowed the stack.\n");
  439.   Microcode_Termination (TERM_STACK_OVERFLOW);
  440.   /*NOTREACHED*/
  441. }
  442.  
  443. /* Utility primitives. */
  444.  
  445. #define IDENTITY_LENGTH     20    /* Plenty of room */
  446. #define ID_RELEASE        0    /* System release (string) */
  447. #define ID_MICRO_VERSION    1    /* Microcode version (fixnum) */
  448. #define ID_MICRO_MOD        2    /* Microcode modification (fixnum) */
  449. #define ID_PRINTER_WIDTH    3    /* TTY width (# chars) */
  450. #define ID_PRINTER_LENGTH    4    /* TTY height (# chars) */
  451. #define ID_NEW_LINE_CHARACTER    5    /* #\Newline */
  452. #define ID_FLONUM_PRECISION    6    /* Flonum mantissa (# bits) */
  453. #define ID_FLONUM_EPSILON    7    /* Flonum epsilon (flonum) */
  454. #define ID_OS_NAME        8    /* OS name (string) */
  455. #define ID_OS_VARIANT        9    /* OS variant (string) */
  456. #define ID_STACK_TYPE        10    /* Scheme stack type (string) */
  457.  
  458. #ifdef USE_STACKLETS
  459. #define STACK_TYPE_STRING "stacklets"
  460. #else
  461. #define STACK_TYPE_STRING "standard"
  462. #endif
  463.  
  464. DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_microcode_identify, 0, 0, 0)
  465. {
  466.   fast SCHEME_OBJECT Result;
  467.   PRIMITIVE_HEADER (0);
  468.   Result = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
  469.   FAST_VECTOR_SET (Result, ID_RELEASE,
  470.            (char_pointer_to_string ((unsigned char *) RELEASE)));
  471.   FAST_VECTOR_SET
  472.     (Result, ID_MICRO_VERSION, (LONG_TO_UNSIGNED_FIXNUM (VERSION)));
  473.   FAST_VECTOR_SET
  474.     (Result, ID_MICRO_MOD, (LONG_TO_UNSIGNED_FIXNUM (SUBVERSION)));
  475.   FAST_VECTOR_SET
  476.     (Result, ID_PRINTER_WIDTH, (LONG_TO_UNSIGNED_FIXNUM (OS_tty_x_size ())));
  477.   FAST_VECTOR_SET
  478.     (Result, ID_PRINTER_LENGTH, (LONG_TO_UNSIGNED_FIXNUM (OS_tty_y_size ())));
  479.   FAST_VECTOR_SET
  480.     (Result, ID_NEW_LINE_CHARACTER, (ASCII_TO_CHAR ('\n')));
  481.   FAST_VECTOR_SET
  482.     (Result, ID_FLONUM_PRECISION, (LONG_TO_UNSIGNED_FIXNUM (DBL_MANT_DIG)));
  483.   FAST_VECTOR_SET
  484.     (Result, ID_FLONUM_EPSILON, (double_to_flonum ((double) DBL_EPSILON)));
  485.   FAST_VECTOR_SET
  486.     (Result, ID_OS_NAME, (char_pointer_to_string ((unsigned char *) OS_Name)));
  487.   FAST_VECTOR_SET (Result, ID_OS_VARIANT,
  488.            (char_pointer_to_string ((unsigned char *) OS_Variant)));
  489.   FAST_VECTOR_SET (Result, ID_STACK_TYPE,
  490.            (char_pointer_to_string
  491.             ((unsigned char *) STACK_TYPE_STRING)));
  492.   PRIMITIVE_RETURN (Result);
  493. }
  494.  
  495. DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_microcode_tables_filename, 0, 0, 0)
  496. {
  497.   PRIMITIVE_HEADER (0);
  498.   PRIMITIVE_RETURN
  499.     (char_pointer_to_string ((unsigned char *) option_utabmd_file));
  500. }
  501.  
  502. DEFINE_PRIMITIVE ("MICROCODE-LIBRARY-PATH", Prim_microcode_library_path, 0, 0, 0)
  503. {
  504.   PRIMITIVE_HEADER (0);
  505.   {
  506.     CONST char ** scan = option_library_path;
  507.     CONST char ** end = option_library_path;
  508.     while (1)
  509.       if ((*end++) == 0)
  510.     {
  511.       end -= 1;
  512.       break;
  513.     }
  514.     {
  515.       SCHEME_OBJECT result =
  516.     (allocate_marked_vector (TC_VECTOR, (end - scan), 1));
  517.       SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
  518.       while (scan < end)
  519.     (*scan_result++) =
  520.       (char_pointer_to_string ((unsigned char *) *scan++));
  521.       PRIMITIVE_RETURN (result);
  522.     }
  523.   }
  524. }
  525.  
  526. static SCHEME_OBJECT
  527. DEFUN (argv_to_object, (argc, argv), int argc AND CONST char ** argv)
  528. {
  529.   SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, argc, 1));
  530.   CONST char ** scan = argv;
  531.   CONST char ** end = (scan + argc);
  532.   SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
  533.   while (scan < end)
  534.     (*scan_result++) = (char_pointer_to_string ((unsigned char *) *scan++));
  535.   return (result);
  536. }
  537.  
  538. DEFINE_PRIMITIVE ("GET-COMMAND-LINE", Prim_get_command_line, 0, 0, 0)
  539. {
  540.   PRIMITIVE_HEADER (0);
  541.   PRIMITIVE_RETURN (argv_to_object (option_saved_argc, option_saved_argv));
  542. }
  543.  
  544. DEFINE_PRIMITIVE ("GET-UNUSED-COMMAND-LINE", Prim_get_unused_command_line, 0, 0, 0)
  545. {
  546.   PRIMITIVE_HEADER (0);
  547.   if (option_unused_argv == 0)
  548.     PRIMITIVE_RETURN (SHARP_F);
  549.   {
  550.     SCHEME_OBJECT result =
  551.       (argv_to_object (option_unused_argc, option_unused_argv));
  552.     option_unused_argv = 0;
  553.     PRIMITIVE_RETURN (result);
  554.   }
  555. }
  556.  
  557. DEFINE_PRIMITIVE ("RELOAD-SAVE-STRING", Prim_reload_save_string, 1, 1, 0)
  558. {
  559.   PRIMITIVE_HEADER (1);
  560.   if (reload_saved_string != 0)
  561.     {
  562.       free (reload_saved_string);
  563.       reload_saved_string = 0;
  564.     }
  565.   if ((ARG_REF (1)) != SHARP_F)
  566.     {
  567.       CHECK_ARG (1, STRING_P);
  568.       {
  569.     unsigned int length = (STRING_LENGTH (ARG_REF (1)));
  570.     reload_saved_string = (malloc (length));
  571.     if (reload_saved_string == 0)
  572.       error_external_return ();
  573.     reload_saved_string_length = length;
  574.     {
  575.       char * scan = ((char *) (STRING_LOC ((ARG_REF (1)), 0)));
  576.       char * end = (scan + length);
  577.       char * scan_result = reload_saved_string;
  578.       while (scan < end)
  579.         (*scan_result++) = (*scan++);
  580.     }
  581.       }
  582.     }
  583.   PRIMITIVE_RETURN (UNSPECIFIC);
  584. }
  585.  
  586. DEFINE_PRIMITIVE ("RELOAD-RETRIEVE-STRING", Prim_reload_retrieve_string, 0, 0, 0)
  587. {
  588.   PRIMITIVE_HEADER (0);
  589.   if (reload_saved_string == 0)
  590.     PRIMITIVE_RETURN (SHARP_F);
  591.   {
  592.     SCHEME_OBJECT result =
  593.       (memory_to_string (reload_saved_string_length,
  594.              ((unsigned char *) reload_saved_string)));
  595.     free (reload_saved_string);
  596.     reload_saved_string = 0;
  597.     PRIMITIVE_RETURN (result);
  598.   }
  599. }
  600.